COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		Here's another  samefringe that illustrates the notion of
C00004 00003	(defun fr-cdr (x) (gopher (cdr x)))
C00005 ENDMK
C⊗;
	Here's another  samefringe that illustrates the notion of
stream, perhaps not quite in the same way as in the Lisp Machine Manual.
The idea is to convert the S-expressions  x  and  y   whose fringes
are to be compared into objects that behave like lists of atoms when
the special functions  fr-car,  fr-cdr  and  fr-null  are applied.  Then
samefringe  reduces to a program that behaves like a version of  equal
specialized to lists of atoms.  We have

(defun samefringe (x y) (fr-equal (fr-make x) (fr-make y)))

(defun fr-equal (u v)
       (or (and (fr-null u)
		(fr-null v))
	   (and (not (fr-null u))
		(not (fr-null v))
		(eq (fr-car u) (fr-car v))
		(fr-equal (fr-cdr u) (fr-cdr v)))))

This is a slightly different  gopher  than the one in the book.  The
There is a small problem with termination that can be solved in 
several ways.  

(defun gopher (x)
       (if (or (atom x) (atom (car x)))
	   x
	   (gopher (cons (caar x) (cons (cdar x) (cdr x))))))

(defun fr-make (x) (gopher x))

(defun fr-null (x) (equal x '((nil))))

(defun fr-car (x) (if (atom x) x (car x)))

(defun fr-cdr (x) (if (atom x) '((nil)) (gopher (cdr x))))

(defun fr-cdr (x) (gopher (cdr x)))

(defun samefringe (x y) (fr-equal (gopher x) (gopher y)))

(defun fr-equal (x y) (or (eq x y)
			  (and (not (atom x))
			       (not (atom y))
			       (eq (car x) (car y))
			       (fr-equal (fr-cdr x) (fr-cdr y)))))

(defun gopher (x)
       (if (or (atom x) (atom (car x)))
	   x
	   (gopher (cons (caar x) (cons (cdar x) (cdr x))))))